home *** CD-ROM | disk | FTP | other *** search
/ Skunkware 5 / Skunkware 5.iso / tls / tls088.hpux.Z / tls088.hpux / lib / vtcl / tests / hlist.tcl < prev    next >
Encoding:
Text File  |  1995-07-20  |  10.2 KB  |  443 lines
  1. # CVS $Id: hlist.tcl,v 1.3 1995/04/29 16:07:24 zibi Exp $
  2. #
  3. # This creates a drawn list with some extra data to maintain
  4. # a hierarch of records
  5. #
  6. proc VxExpandoList {dlist addProc fmt args} {
  7.     
  8.     set dlist [eval VtDrawnList $dlist $args]
  9.  
  10.     set fmt [linsert $fmt 0 {DATA}]
  11.  
  12.     # Associate format and count to this list
  13.     # 
  14.     VxSetVar $dlist format $fmt
  15.     VxSetVar $dlist count  0
  16.  
  17.     return $dlist
  18. }
  19.  
  20. #
  21. # This deletes all positions
  22. # below pos that have a greater level.
  23. #
  24. proc VxExpandoCollapse {dlist pos} {
  25.     set count [VxGetVar $dlist count]
  26.  
  27.     if {$pos >= $count} {
  28.     return
  29.     }
  30.  
  31.     VxExpandoDeleteItem $dlist $pos on
  32. }
  33.  
  34. proc VxExpandoGetLevel {dlist pos} {
  35.  
  36.     set record [VtDrawnListGetItem $dlist -position $pos]
  37.     set record [lindex $record 0]
  38.  
  39.     set recordLevel [lindex $record 0]
  40.     return $recordLevel
  41. }
  42.  
  43. proc VxExpandoGetIcon {dlist pos} {
  44.  
  45.     set record [VtDrawnListGetItem $dlist -position $pos]
  46.     set record [lindex $record 0]
  47.  
  48.     set icons [lindex $record 1]
  49.     set end [llength $icons]
  50.     return [lrange $icons $end end]
  51. }
  52.  
  53. proc VxExpandoSetIcon {dlist pos icon} {
  54.     set record [VtDrawnListGetItem $dlist -position $pos]
  55.     set record [lindex $record 0]
  56.  
  57.     set icons [lindex $record 1]
  58.     set icons [lreplace $icons end end $icon]
  59.     set record [lreplace $record 1 1 $icons]
  60.     VtDrawnListSetItem $dlist -position $pos -fieldList $record
  61. }
  62.  
  63. proc VxExpandoGetRecord {dlist pos level icon rec} {
  64.     
  65.     set record [VtDrawnListGetItem $dlist -position $pos]
  66.     set record [lindex $record 0]
  67.  
  68.     set icons [lindex $record 1]
  69.  
  70.     upvar 1 $icon rIcon $rec rRecord $level rLevel
  71.  
  72.     set rLevel  [lindex $record  0]
  73.     set end     [llength $icons]
  74.     set rIcon   [lrange $icons $end end]
  75.     set rRecord [lrange $record 2 end]
  76. }
  77.  
  78. #
  79. # The next two functions return true if the icon has a
  80. # upwards or downward connector component
  81. #
  82. proc hasDown {icon} {
  83.     switch $icon {
  84.     CONNECT_I -
  85.     CONNECT_T  {
  86.         return 1
  87.     }
  88.     default {
  89.         return 0
  90.     }
  91.     }
  92. }
  93.  
  94. proc hasUp {icon} {
  95.     switch $icon {
  96.     CONNECT_L -
  97.     CONNECT_I -
  98.     CONNECT_T  {
  99.         return 1
  100.     }
  101.     default {
  102.         return 0
  103.     }
  104.     }
  105. }
  106.  
  107. #
  108. # Sets the icon connector for the n'th record in the dlist
  109. # 
  110. # dlist        - DrawnList
  111. # n        - position of record in the drawnlist
  112. # col        - position of icon in the record.  The icons are in the second
  113. #          elements of the record.  
  114. # connector    - connector to set to.
  115. #
  116. proc setIconConnector {dlist n col connector} {
  117.     set rec [VtDrawnListGetItem $dlist -position $n]
  118.     set rec [lindex $rec 0]
  119.  
  120.     set icons [lindex $rec 1]
  121.     if {$col < [llength $icons]} {
  122.     set icons [lreplace $icons $col $col $connector]
  123.     }
  124.  
  125.     set rec [lreplace $rec 1 1 $icons]
  126.  
  127.     VtDrawnListSetItem $dlist -position $n -fieldList $rec
  128. }
  129.  
  130. proc getIconConnector {dlist n col} {
  131.     set rec [VtDrawnListGetItem $dlist -position $n]
  132.     set rec [lindex $rec 0]
  133.  
  134.     set icons [lindex $rec 1]
  135.     if {$col < [llength $icons]} {
  136.     return [lindex $icons $col]
  137.     } else {
  138.     return ""
  139.     }
  140. }
  141.  
  142. #
  143. # "Patches" all the connectors to the left of the current
  144. # record up the next record that has the same level.
  145. #
  146. # dlist        - drawnlist
  147. # pos        - record position to start the patch
  148. # level        - level of the heirarchy
  149. # cmd        - "ADD" or "SUB" to add or subtract a vertical component.
  150. #
  151. proc patchConnectors {dlist pos level cmd} {
  152.     set indx [expr $level - 1]
  153.     while {1} {
  154.     set icon [getIconConnector $dlist $pos $indx]
  155.     set rLevel [VxExpandoGetLevel $dlist $pos]
  156.     
  157.     if {$cmd == "ADD"} {
  158.         if {$icon == "NO_ICON"} {
  159.         set icon CONNECT_I
  160.         } elseif {$icon == "CONNECT_L"} {
  161.         set icon CONNECT_T
  162.         } 
  163.     } else {
  164.         echo "icon $icon pos $pos"
  165.         echo "rLevel $rLevel $level "
  166.  
  167.         if {$icon == "CONNECT_I"} {
  168.         set icon NO_ICON
  169.         } elseif {$icon == "CONNECT_T"} {
  170.         set icon CONNECT_L
  171.         }
  172.     }
  173.  
  174.     setIconConnector $dlist $pos $indx $icon
  175.     
  176.     incr pos -1
  177.     if {$rLevel <= $level} {break}
  178.     }
  179. }
  180.  
  181. #
  182. # This proc analyzes the icon connectors. It gets the connector information
  183. # for the current position and will generate a connector list based
  184. # on that position.
  185. proc _analyzeConnect {dlist pos level icon} {
  186.     if {$level == 0} { return $icon }
  187.  
  188.     set count [VxGetVar $dlist count]
  189.     if {$pos == 0} {set pos $count}
  190.  
  191.     # Get the record above and below the one we want to insert
  192.     set aboveRec [VtDrawnListGetItem $dlist -position [expr $pos - 1] ]
  193.     set aboveRec [lindex $aboveRec 0]
  194.  
  195.     if {$pos < $count} {
  196.         set belowRec [VtDrawnListGetItem $dlist -position [expr $pos]]
  197.     set belowRec [lindex $belowRec 0]
  198.     } else {
  199.     set belowRec ""
  200.     }
  201.  
  202.     set aboveIcons [lindex $aboveRec 1]
  203.     set belowIcons [lindex $belowRec 1]
  204.     set currentIcons ""
  205.  
  206.     # analyze all position up to the one before the icon
  207.     set endLevel [expr $level - 1]
  208.     for {set i 0} {$i < $endLevel} {incr i} {
  209.     set abvIcon [lindex $aboveIcons $i]
  210.     set blwIcon [lindex $belowIcons $i]
  211.  
  212.     if {[hasDown $abvIcon] && [hasUp $blwIcon]} {
  213.         lappend currentIcons CONNECT_I
  214.     } else {
  215.         lappend currentIcons NO_ICON
  216.     }
  217.     }    
  218.     
  219.     # analyze the connector position just before the icon
  220.     set abvIcon [lindex $aboveIcons $endLevel]
  221.     set blwIcon [lindex $belowIcons $endLevel]
  222. # echo $abvIcon .. $blwIcon ++ $aboveRec
  223.  
  224.    if {[hasUp $blwIcon]} {
  225.     lappend currentIcons CONNECT_T
  226.     } else {
  227.     lappend currentIcons CONNECT_L
  228.     }
  229.     
  230.     lappend currentIcons 4 $icon
  231.  
  232.     return $currentIcons
  233. }
  234.  
  235. proc isConnector {i} {
  236.     switch $i {
  237.     NO_ICON   -
  238.     CONNECT_L -
  239.     CONNECT_I -
  240.     CONNECT_T  {
  241.         return 1
  242.     }
  243.     default {
  244.         return 0
  245.     }
  246.     }
  247. }
  248.       
  249. #
  250. # dlist     - drawnlist to add to
  251. # pos        - position to add to
  252. # level        - record level
  253. # icon        - pixmap to use for this record
  254. # data        - formatList data
  255. proc VxExpandoAddItem {dlist pos level icon data} {
  256.     #
  257.     # Get dlist info
  258.     set count [VxGetVar $dlist count]
  259.     set fmt   [VxGetVar $dlist format]
  260.  
  261.     set fmt [_genFormat $fmt $level]
  262.     set connectors [_analyzeConnect $dlist $pos $level $icon]
  263.  
  264.     set data [linsert $data 0 $level $connectors]
  265.  
  266.     eval [list VtDrawnListAddItem $dlist -formatList $fmt -fieldList $data \
  267.              -position $pos ]
  268.  
  269.     if {$pos == 0} {
  270.     set pos $count
  271.     } else {
  272.     incr pos -1
  273.     }
  274.  
  275.     # Now fix all the connectors between the current one and all
  276.     # above 
  277.     if {$level > 0} {
  278.     patchConnectors $dlist $pos $level ADD
  279.     }
  280.  
  281.     incr count 1
  282.  
  283.     VxSetVar $dlist count $count
  284. }
  285.  
  286. #
  287. # This deletes an items in the hlist.  If you delete a container record
  288. # it'll delete all items in the container.
  289. #
  290. proc VxExpandoDeleteItem {dlist pos {collaspe off} } {
  291.     set count [VxGetVar $dlist count]
  292.     set startLevel [VxExpandoGetLevel $dlist $pos]
  293.  
  294.     if {[getIconConnector $dlist $pos [expr $startLevel-1]] == "CONNECT_L"} {
  295.     set patch on
  296.     } else {
  297.     set patch off
  298.     }
  299.  
  300.     if {$collaspe} {incr pos}
  301.  
  302.     while {$pos <= $count} {
  303.     VtDrawnListDeleteItem $dlist -position $pos
  304.  
  305.     incr count -1
  306.     if {$count == 0 || $pos > $count} {break}
  307.  
  308.     set level [VxExpandoGetLevel $dlist $pos]
  309.  
  310.     if {$level <= $startLevel} {break}
  311.     }
  312.  
  313.     if {$patch} {
  314.     incr pos -1
  315.     patchConnectors $dlist $pos $startLevel SUB
  316.     }
  317.  
  318.     # Select the next item
  319.     if {$count} {
  320.     if {$pos > $count} { set pos 1 }
  321.     VtDrawnListSelectItem $dlist -position $pos
  322.     }
  323.  
  324.     VxSetVar $dlist count $count
  325. }
  326.  
  327. #
  328. # This sets the width of the icon connector column
  329. # 
  330. proc _genFormat {userFormat level} {
  331.  
  332.     set fList [list ICON [expr $level+2] ]
  333.  
  334.     set fmt [linsert $userFormat 1 $fList]
  335.     return $fmt
  336. }    
  337.  
  338. # ----------------------------------------------------------------------
  339.  
  340. proc addBogus {dlist pos level} {
  341.  
  342.     incr pos
  343.  
  344.     set bigStr "WWWWWWWWAAAAAAAAAAWWAWSA01234566"
  345.     VxExpandoAddItem $dlist $pos $level 0 { "New 1.9" "hide" "hide"}; incr pos
  346.     VxExpandoAddItem $dlist $pos $level 2 { "New 2.9" "hide" "hide"}; incr pos
  347.     VxExpandoAddItem $dlist $pos $level 0 $bigStr
  348. }
  349.  
  350. #
  351. # This routine adds three icons underneath the current directory
  352. #
  353. proc addCB {cbs} {
  354.     set dlog [keylget cbs dialog]
  355.     
  356.     set dlist [VxGetVar $dlog dlist]
  357.  
  358.     set pos   [VtDrawnListGetSelectedItem $dlist -byPositionList]
  359.  
  360.     VxExpandoGetRecord $dlist $pos level icon record
  361.  
  362.     if {$icon == 0} {
  363.     VxExpandoSetIcon $dlist $pos 1
  364.     addBogus $dlist $pos [expr $level + 1]
  365.     }
  366. }
  367.  
  368. proc deleteCB {cbs} {
  369.     set dlog [keylget cbs dialog]
  370.  
  371.     set dlist [VxGetVar $dlog dlist]
  372.  
  373.  
  374.     set pos [VtDrawnListGetSelectedItem $dlist -byPositionList]
  375.  
  376.     VxExpandoDeleteItem $dlist $pos
  377. }
  378.  
  379. proc defaultCB {cbs} {
  380.     set dlog [keylget cbs dialog]
  381.  
  382.     set dlist [VxGetVar $dlog dlist]
  383.  
  384.     set pos [VtDrawnListGetSelectedItem $dlist -byPositionList]
  385.     VxExpandoGetRecord $dlist $pos level icon record
  386.  
  387.     if {$icon == 0} {
  388.     VxExpandoSetIcon $dlist $pos 1
  389.     addBogus $dlist $pos [expr $level + 1]
  390.     } elseif {$icon == 1} {
  391.     VxExpandoSetIcon $dlist $pos 0
  392.     VxExpandoCollapse $dlist $pos
  393.     }
  394. }
  395.  
  396. proc QuitCB {cbs} {
  397.      VtClose
  398.      exit
  399. }
  400.  
  401. set ap [VtOpen hlist]
  402.  
  403. set dlog [VtFormDialog $ap.form \
  404.       -okCallback     addCB           -okLabel         Add \
  405.       -applyCallback  QuitCB    -applyLabel     "Quit" \
  406.       -cancelCallback deleteCB      -cancelLabel       Delete ]
  407.  
  408. set dlist [VxExpandoList $dlog.list \
  409.            addCB {{STRING 20 5} {DATA} {DATA}} \
  410.            -iconList {dir.px odir.px exec.px file.px check.px} \
  411.            -rows 14 -columns 20 \
  412.            -horizontalScrollBar 1 \
  413.            -labelList {"icon" "abcdefghijklmnopqur1234567892jdjfkl"} \
  414.            -labelFormatList {{ICON 1} {STRING 20}} \
  415.            -defaultCallback defaultCB \
  416.            -rightSide FORM -bottomSide FORM ]
  417.  
  418. VtShow $dlog
  419.  
  420. VxExpandoAddItem $dlist 0 0 1 { "Hello 1" "hide" "hide"}
  421. VxExpandoAddItem $dlist 0 1 1 { "Hello 2" "hide" "hide"}
  422. VxExpandoAddItem $dlist 0 2 0 { "Hello 3" "hide" "hide"}
  423. VxExpandoAddItem $dlist 0 2 0 { "Hello 4" "hide" "hide"}
  424. VxExpandoAddItem $dlist 0 2 1 { "Hello 5" "hide" "hide"}
  425. VxExpandoAddItem $dlist 0 3 0 { "Hello 6" "hide" "hide"}
  426. VxExpandoAddItem $dlist 0 2 0 { "Hello 7" "hide" "hide"}
  427. VxExpandoAddItem $dlist 0 1 1 { "Hello 8" "hide" "hide"}
  428. VxExpandoAddItem $dlist 0 2 0 { "Hello 9" "hide" "hide"}
  429. VxExpandoAddItem $dlist 0 3 0 { "Hello a" "hide" "hide"}
  430. VxExpandoAddItem $dlist 0 1 0 { "Hello b" "hide" "hide"}
  431. VxExpandoAddItem $dlist 0 1 0 { "Hello c" "hide" "hide"}
  432. VxExpandoAddItem $dlist 0 0 0 { "Hello d" "hide" "hide"}
  433.  
  434. VxExpandoAddItem $dlist 11 1 0 { "Hello between" "hide" "hide"}
  435.  
  436. VxSetVar $dlog dlist $dlist
  437.  
  438. VtDrawnListSelectItem $dlist -position 3
  439.  
  440. VtMainLoop
  441.  
  442.  
  443.